home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / rkpls301.zip / RKPDEMO.ZIP / SAMPLE1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-04  |  5KB  |  196 lines
  1. Program Sample1;
  2.  
  3. {
  4.  This is a demonstration programme using RkPlus.
  5.  It uses 2 registration levels (0 and 1).
  6.  If a Level 1 key has expired, it will be treated as Level 0.
  7.  If a Level 0 key has expired, it will be treated as Unregistered.
  8.  This is a very simple programme that doesn't actually do anything, but it
  9.  should demonstrate some of what can be done with RkPlus.  It uses
  10.  a key file (SAMPLE.RKP) which can be created by GenFile or Register.
  11.  
  12.  Sample1 uses the sample encoding unit Encode.
  13. }
  14.  
  15.  
  16. Uses
  17.   Crt,
  18.   RkPlus,
  19.   Encode;
  20.  
  21.  
  22. Const
  23.   MonthNames : Array[1..12] of String[3]
  24.   = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  25.  
  26.  
  27. Var
  28.   kc : Char;
  29.  
  30.  
  31. Procedure BadRegBeep;
  32.  
  33. Begin
  34.   Sound(1200);
  35.   Delay(200);
  36.   Sound(600);
  37.   Delay(200);
  38.   Sound(1200);
  39.   Delay(200);
  40.   Sound(600);
  41.   Delay(200);
  42.   NoSound;
  43. End;
  44.  
  45.  
  46. Procedure NotRegBeep;
  47.  
  48. Begin
  49.   Sound(600);
  50.   Delay(200);
  51.   Sound(1200);
  52.   Delay(200);
  53.   NoSound;
  54. End;
  55.  
  56.  
  57. Procedure DoView;
  58.  
  59. Begin
  60.   WriteLn('Sample data :');
  61.   WriteLn;
  62.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  63.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  64.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  65.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  66.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  67.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  68.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  69.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  70. End;
  71.  
  72.  
  73. Procedure DoCalc;
  74.  
  75. Begin
  76.   If Rkp.Registered then Begin
  77.     Write('The calculated result is ');
  78.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  79.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  80.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  81.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  82.   End Else
  83.     WriteLn('Only available in registered version!');
  84. End;
  85.  
  86.  
  87. Procedure DoTest;
  88.  
  89. Begin
  90.   If Rkp.Registered then Begin
  91.     If (Rkp.Level > 0) then Begin
  92.       Write('Performing tests...');
  93.       Delay(300);
  94.       WriteLn;
  95.       WriteLn('All tests passed.');
  96.     End Else
  97.       WriteLn('Not available in demo version!');
  98.   End Else
  99.     WriteLn('Only available in registered version!');
  100. End;
  101.  
  102.  
  103. Begin
  104.   If Not RkpOK then Begin
  105.     WriteLn('Unexpected Error ',RkpError,'!');
  106.     Halt(255);
  107.   End;
  108.   If BadSystemDate then Begin
  109.     WriteLn('You must correctly set your system clock to run Sample1!');
  110.     BadRegBeep;
  111.     Halt(1);
  112.   End;
  113.   SetProgID('Sample');
  114.   SetKeyFile('Sample');
  115.   GetRegInfo;
  116.   Write('Sample1');
  117.   If Not RkpOK then
  118.     WriteLn(' [invalid]')
  119.   Else If Rkp.Registered and (Rkp.Level > 0) then
  120.     WriteLn(' [registered]')
  121.   Else If Rkp.Registered then
  122.     WriteLn(' [demo]')
  123.   Else
  124.     WriteLn(' [unregistered]');
  125.   WriteLn('Sample of RkPlus methods 1 and 2 (with user-written encoding)');
  126.   WriteLn('See RKPLUS.DOC for more info');
  127.   WriteLn;
  128.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  129.     WriteLn(KeyFileName,' has been altered!');
  130.     BadRegBeep;
  131.     Halt(1);
  132.   End Else If (RkpError = ExpiredKey) then Begin
  133.     If (Rkp.Level > 0) then Begin
  134.       WriteLn('Your registration key has expired!');
  135.       WriteLn('You will be given DEMO access.');
  136.       NotRegBeep;
  137.       Rkp.Level := 0;
  138.     End Else Begin
  139.       WriteLn('Your demo key has expired!');
  140.       WriteLn('You will be given UNREGISTERED access.');
  141.       NotRegBeep;
  142.       Rkp.Registered := False;
  143.     End;
  144.   End Else If Rkp.Registered then Begin
  145.     If (Rkp.Level > 0) then Begin
  146.       WriteLn('This version of Sample1 is registered to ',Rkp.Name1);
  147.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  148.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  149.       WriteLn('Thank you for registering!');
  150.     End Else Begin
  151.       WriteLn('This version of Sample1 is a limited use demo for ',Rkp.Name1);
  152.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  153.         WriteLn('This demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  154.       WriteLn('Don''t forget to register!');
  155.     End;
  156.   End Else If Not RkpOK then Begin
  157.     WriteLn('Unexpected error ',RkpError,'!');
  158.     Halt(255);
  159.   End Else Begin
  160.     WriteLn('This version of Sample1 is unregistered.');
  161.     NotRegBeep;
  162.     Delay(500);
  163.   End;
  164.   WriteLn;
  165.   WriteLn('Sample1 Menu');
  166.   WriteLn;
  167.   WriteLn('[V]iew sample data');
  168.   Write('[C]alculate');
  169.   If Not Rkp.Registered then
  170.     WriteLn('  (only available in registered version)')
  171.   Else
  172.     WriteLn;
  173.   Write('[T]est results');
  174.   If Not Rkp.Registered then
  175.     WriteLn('  (only available in registered version)')
  176.   Else If (Rkp.Level <= 0) then
  177.     WriteLn('  (not available in demo version)')
  178.   Else
  179.     WriteLn;
  180.   WriteLn;
  181.   Write('Selection : ');
  182.   kc := UpCase(ReadKey);
  183.   WriteLn;
  184.   WriteLn;
  185.   Case kc of
  186.   'V' :
  187.     DoView;
  188.   'C' :
  189.     DoCalc;
  190.   'T' :
  191.     DoTest;
  192.   Else
  193.     WriteLn('Invalid selection!');
  194.   End;
  195. End.
  196.